
{$ifndef modif}{$i modif.inc}{$endif}
Program View;

uses {$ifdef crtx}crtx,{$else}crt,{$endif}
     {$ifdef fgraph}fGraph,{$else}
       {$ifdef graph}Graf6,graph,wind2,{$endif}   {For proper display graph or fgraph must be defined}
     {$endif}
     Pictures;

type StoppingLineProc=object(AbstractLineProc)
	stopped:Boolean;
	Procedure InitPassing(Count:Word;Name:Pchar); virtual;
	Function NextLine:integer;	virtual;
	end;


var p,p2:Picture;
    v:VectorPicture;
    chamel:^AbstractPicture;
    ext:string[4];
    i:Byte;
    k:char;
    kw:word;
    incr:integer;
    LastTime:Longint;
    NewPalette:PPalette;
    GrDriver:integer;
    CheckStop:StoppingLineProc;
    PassLProc:PercentLineProc;


Function GetInterval:Longint; assembler;
asm
	MOV	AH,0
	INT	1Ah
	MOV	AX,DX
	MOV	DX,CX
end;

Function ReadkeyEX : word;  assembler;
asm
	MOV	AH,00
	INT	16h
end;


Procedure StoppingLineProc.initPassing(Count:Word;Name:Pchar);
begin
 stopped:=False;
 pases:=count-1;
 if pases<=0 then pases:=1;
 actualPass:=0;
 Description:=Name;
end;

Function StoppingLineProc.NextLine:integer;
var i:longint;
begin
 NextLine:=0;
 if KeyPressed then
	begin
	kw:=readkeyEX;

	if (kw=72*$100) and (offsetY=0) then 	{cursor up}
		exit;
	if (kw=75*$100) and (offsetX=0) then	{cursor left}
		exit;
	if (kw=80*$100) and (offsetY=chamel^.y-GetMaxY) then {cursor down}
		exit;
	if (kw=77*$100) and (offsetX=chamel^.x-GetMaxX) then
		exit;

	NextLine:=-1;
	stopped:=true;
	end;
end;


Function GetTypeStr(typ:char):string;
begin
GetTypeStr:='';
case typ of 'G':GetTypeStr:='Gray Scalled';
	    'P':GetTypeStr:='Palette pseudocolor';
	    'C':GetTypeStr:='True color';
	    'V':GetTypeStr:='Vector';
	 end;
end;

label 10,PoSun,PoSun2;
begin
PassLProc.init;
CheckStop.Init;
p.init;
p2.init;
v.init;
NewPalette:=nil;

Writeln('<<<View>>> An image viewer. (c)1995-2009 F&FSoft');
if paramcount<1 then writeln('Too little parametters!');
if ((ParamStr(1)='-?')or(ParamStr(1)='/?'))or(ParamCount<1) then
	begin
	writeln('Viewer of Graphic pictures - Supported formats are BMP,CUT,FTG,GIF,ICO,'+
		{$ifdef jpg}'JPG,'+{$endif}
		'OKO,PBM,'#10#13+
		'						   PCX,RAS,RLE,TGA,TIF,WPG'#10#13+
		'Usage:   VIEW  NameOfPicture'#10#10#13+
		'When an image is opened and displayed press F1 for more help.');
	goto 10;
	end;

ext:=copy(ParamStr(1),length(ParamStr(1))-2,3);
for i:=1 to length(ext) do ext[i]:=upcase(ext[i]);

if ((ext='ASC')or(ext='HPG'))or(ext='VEC') then chamel:=@v
					   else chamel:=@p;
write(#13' loading ');ClrEol;
LoadPicture(chamel^,ParamStr(1),@PassLProc);
if not(chamel^.valid) then
	begin
	writeln(#13'Error while loading file: ',ParamStr(1),' !');
	goto 10;
	end;

{$ifdef Fgraph}
i:=5;
while ((p.x<Vmodes[Vrezimy[i]].SizeX)and(p.y<Vmodes[Vrezimy[i]].SizeY))
	and (i>0) do
		  dec(i);

{i:=0;{}

GrDriver:=-Svga256;
if InitGraph(GrDriver,i or 128,'')<>0 then Goto 10;
{$else}
 OpenGraph;
{$endif}
 ClearDevice;
 chamel^.view(nil);
 offsetX:=0;offsetY:=0;
 incr:=1;
 repeat
  kw:=readkeyEX;
  k:=upcase(chr(kw));

  if (k in ['0'..'9'])and(p.Valid) then
	begin
	SetPalette :=True;
	if (k='0') and p2.Valid then
		begin
		p2.Erase;
		end
	   else begin
		peelplane(p,p2,ord(k)-ord('0'));
		chamel:=@p2;
		end;
	if not(p2.valid) then chamel:=@p;
	goto PoSun2;
	end;

  if k in ['D','V','H'] then
	begin
	flip(k,p,nil);
	goto PoSun2;
	end;

  if k='I' then
	begin
	SetPalette :=True;	{paletu je treba znovu prenastavit}
	if p2.valid then invert(p2,nil)
		    else invert(p,nil);
	goto PoSun2;
	end;

  if k in ['R','G','B','J','M','C'] then
	begin
	if NewPalette<>nil then
			begin
			chamel^.palette:=NewPalette;
			NewPalette:=nil;
			end;

	if (p2.valid) then
		begin
		p2.erase;
		end
	   else begin
		Separate(p,p2,k,nil);
		chamel:=@p2;
		end;

	if not(p2.valid) then chamel:=@p;
	goto PoSun2;
	end;


  if (k='Y') then
    begin
    if (p2.valid) then
	begin
	p2.erase;
	end

	else
	begin
	if p.typ='C' then	{true color image}
		begin
		convert(p,p2,8,'G',False,nil);
		chamel:=@p2;
		end;
	if p.typ='P' then	{palette image}
		begin
		SetPalette :=True;	{paletu je treba znovu prenastavit}
		if NewPalette=nil then
			begin
			NewPalette:=chamel^.palette;
			chamel^.palette:=nil;
			end
		   else begin
			chamel^.palette:=NewPalette;
			NewPalette:=nil;
			end;
		   end;
	end;

     if not(p2.valid) then chamel:=@p;
     goto PoSun2;
     end;

  if k=#0 then	{stisknuta sipka}
	begin
	SetPalette :=False;	{paleta uz byla nastavena}
	if abs(LastTime-GetInterval)<9 then incr:=10;
PoSun: 	k:=chr(hi(kw));
{Alt_Y}	if (k=#21)and not(p2.valid) then
		begin
		if p.palette=nil then
			begin
			p.palette:=NewPalette;
			end;
		ReMapPalAsGray(p);
		SetPalette :=True;
		NewPalette:=p.palette;
		p.palette:=nil;
		SetPalette :=True;
		end;

{$ifdef Fgraph}
{F1}	if (k=#59) then begin
			RestoreCRTMode;
			Write(#9#9#9#9'Help Page'#10#13#10+
			      'F1'#9#9#9'Display this help page'#13#10+
			      'Alt F2'#9#9#9'Select For VGA 256 Display driver'#13#10+
			      'Alt F3'#9#9#9'Select For VGA True Color Display driver'#13#10+
			      'Y'#9#9#9'Switch Colour/Gray'#13#10+
			      'Alt_Y'#9#9#9'Sort palette to gray'#13#10+
			      'V,H'#9#9#9'Flip Horizontally or vertically'#13#10,
			      'I'#9#9#9'Inverse image content'#13#10+
			      'Esc'#9#9#9'Quit'#13#10#10,
			      'Videomodes for VGA 256 Color Driver:'#13#10);
			for i:=0 to 5 do
				Writeln('  F',i+2,#9#9#9'Switch mode to ',Vmodes[Vrezimy[i]].SizeX,'x',Vmodes[Vrezimy[i]].SizeY);
			write('Videomodes for VGA True Color Driver:'#13#10);
			for i:=0 to 1 do
				Writeln('  F',i+2,#9#9#9'Switch mode to ',VmodesTC[VrezimyTC[i]].SizeX,'x',VmodesTC[VrezimyTC[i]].SizeY);
			write(#10#10'Press any key to return into graphics ...');
			ReadKey;
			SetGraphMode(GetGraphMode or 128);
			SetPalette :=True;
			end;
{F2}	if (k=#60) then begin;offsetX:=0;offsetY:=0;InitGraph(GrDriver,0+128,'');SetPalette :=True;end;
{F3}	if (k=#61) then begin;offsetX:=0;offsetY:=0;InitGraph(GrDriver,1+128,'');SetPalette :=True;end;
{F4}	if (k=#62) then begin;offsetX:=0;offsetY:=0;InitGraph(GrDriver,2+128,'');SetPalette :=True;end;
{F5}	if (k=#63) then begin;offsetX:=0;offsetY:=0;InitGraph(GrDriver,3+128,'');SetPalette :=True;end;
{F6}	if (k=#64) then begin;offsetX:=0;offsetY:=0;InitGraph(GrDriver,4+128,'');SetPalette :=True;end;
{F7}	if (k=#65) then begin;offsetX:=0;offsetY:=0;InitGraph(GrDriver,5+128,'');SetPalette :=True;end;

{AltF2} if (k=#105) then begin;Grdriver:=-Svga256;offsetX:=0;offsetY:=0;InitGraph(GrDriver,0+128,'');SetPalette:=True;end;
{AltF3} if (k=#106) then begin;Grdriver:=-SvgaTC;offsetX:=0;offsetY:=0;InitGraph(GrDriver,0+128,'');SetPalette:=True;end;

{$endif}
	if (k=#75) then dec(offsetX,incr);	{cursor left}
	if (k=#77) then inc(offsetX,incr);
	if (k=#72) then dec(offsetY,incr);	{cursor up}
	if (k=#80) then inc(offsetY,incr);	{cursor down}

{CtrlF1}if (k=#94) then
		begin
		RestoreCRTMode;
		Write(#9#9#9#9'Current Image info'#10#13#10+
			'Size X (width)  ',chamel^.X:3,#13#10+
			'Size Y (heigth) ',chamel^.Y:3,#13#10+
			'Bit Planes      ',chamel^.planes:3,#13#10+
			'Type of image   ',GetTypeStr(chamel^.typ),#13#10+
			'Palette:        ',chamel^.Palette<>nil,#10#13#10#10+
			#9#9#9'    Current Video driver info'#10#13#10+
			'Screen size X   ',GetMaxX,#13#10+
			'Screen size Y   ',GetMaxY,#13#10+
			'Colors          ',GetMaxColor,#13#10+
			'Video Driver    ',GetDriverName);
		write(#13#10#10#10'Press any key to return into graphics ...');
		ReadKey;
		SetGraphMode(GetGraphMode or 128);
		SetPalette :=True;
		end;

	if (longint(offsetX) > longint(chamel^.x)-GetMaxX) then
	  offsetX := chamel^.x-GetMaxX;
	if (offsetX<0) then offsetX:=0;
	if (longint(offsetY) > longint(chamel^.y)-GetMaxY) then
	  offsetY := chamel^.y-GetMaxY;
	if (offsetY<0) then offsetY:=0;

	incr:=10;
PoSun2:	if keypressed then if readkey=#0 then goto Posun;
	CheckStop.Stopped:=False;

	chamel^.view(@CheckStop);

	LastTime:=GetInterval;
	if CheckStop.Stopped then
		begin
		{kw:=readkeyEX;		was read in CheckStop method}
		k:=upcase(chr(kw));
		if k=#0 then goto Posun;
		if k=#27 then Break;
		GoTo PoSun2;
		end;
	incr:=1;
	end;

 until (k=#27)or(k=#13);
CloseGraph;

10:{$ifndef Fgraph}NastavXy;{$endif}
while PeepError<>0 do writeln('Error: ',GetErrorString(ReadError));
v.Done;
p.Done;
p2.Done;
end.
